(defstruct forth-word
  name
  definition)

(defun list-to-word (list)
    (make-forth-word :name       (first list)
                     :definition (rest list)))

(defun make-forth-dictionary (&rest lists)
    (loop for lst in lists
               collect (make-forth-word :name (first lst)
                                        :definition (second lst))))

(defun add-word-to-dictionary (the-word dictionary)
    (cons the-word dictionary))

(defvar *data-stack* nil)

(defparameter *dictionary*
  (make-forth-dictionary
      (list '+ #'(lambda (stack)
                     (let ((a (pop stack))
                           (b (pop stack)))
                         (cons (+ a b)
                               stack))))
      
      (list '- #'(lambda (stack)
                     (let ((a (pop stack))
                           (b (pop stack)))
                         (cons (- b a)
                               stack))))
      
      (list '* #'(lambda (stack)
                     (let ((a (pop stack))
                           (b (pop stack)))
                         (cons (* a b)
                               stack))))
      
      (list '/ #'(lambda (stack)
                     (let ((a (pop stack))
                           (b (pop stack)))
                         (cons (/ a b)
                               stack))))
      
      (list '\. #'(lambda (stack)
                     (print (car stack))
                     (cdr stack)))
      
      (list 'dup #'(lambda (stack)
                       (cons (car stack)
                             stack)))
      (list 'swap #'(lambda (stack)
                        (let ((a (pop stack))
                              (b (pop stack)))
                            (push a stack)
                            (push b stack))))
      (list 'inc   '(1 +))
      ))

(defmacro aif (test then &optional else)
    `(let ((it ,test))
         (if it
             ,then
             ,else)))

(defun find-word-in-dictionary (word-symbol dictionary)
    (loop for w in dictionary
          do (when (equal word-symbol
                          (forth-word-name w))
                 (return w))))

(defun find-word-definition-in-dictionary (word-symbol dictionary)
    (aif (find-word-in-dictionary word-symbol dictionary)
         (forth-word-definition it)))


(defun eval-forth-word (word-symbol stack dictionary)
    (block nil
        (aif (find-word-definition-in-dictionary word-symbol dictionary)
             (cond
               ((functionp it)
                (return (print (funcall it stack))))
               ((listp it)
                (eval-forth-program it
                                    stack
                                    *dictionary*
                                    'eval)))
             (error "Ошибка. Неизвестное слово: ~A" word-symbol))))



(defun eval-forth-program (program stack dictionary state &key (buffer))
    (print stack)
    (let ((current-word (first program)))
        (case state
          ((eval)
           (cond
             ((null program)
              (return-from eval-forth-program stack))
             
             ((eql current-word 'define)
              (eval-forth-program (rest program)
                                  stack
                                  dictionary
                                  'defining))
             ((numberp current-word)
              (eval-forth-program (rest program)
                                  (cons current-word stack)
                                  dictionary
                                  'eval))
             
             ((symbolp current-word)
              (eval-forth-program (rest program)
                                  (eval-forth-word current-word stack dictionary)
                                  dictionary
                                  'eval))))
          
          ((defining)
           (if (eql current-word 'end-define)
               (eval-forth-program (rest program)
                                   stack
                                   (add-word-to-dictionary (list-to-word (nreverse buffer))
                                                           dictionary)
                                   'eval)
               (eval-forth-program (rest program)
                                   stack
                                   dictionary
                                   'defining
                                   :buffer (cons current-word buffer)))))))
